home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.40 / guidestripper / guidestripper.p < prev    next >
Text File  |  1994-11-27  |  12KB  |  470 lines
  1. { ****** Auto-Revision (do NOT edit) ********************
  2.   *
  3.   * © Copyright by BOMBERSOFT
  4.   *
  5.   * Filename          : Sources:GuideStripper.p
  6.   * Created on        : 21-Nov-94  um 14:27:19 Uhr.
  7.   * Created by        : Björn Schotte
  8.   * Current revision  : V1.00 
  9.   *
  10.   *
  11.   * Purpose: Konvertierung AmigaGuide -> ASCII
  12.   *
  13.   *
  14.   * V1.00  kreiert am 21-Nov-94  um 14:27:19 Uhr. LogMessage:
  15.   *        GUI mit Prozent-Fenster eingebaut.
  16.   *
  17.   * V0.000 kreiert am 19-Nov-94  um 16:14:32 Uhr. LogMessage:
  18.   *        --- Initial release ---
  19.   ******************************************************* }
  20. PROGRAM GuideStripper;
  21.  
  22. USES Intuition, Exec, Graphics;
  23.  
  24. {$incl "asl.lib",
  25.         "gadtools.lib",
  26.          "workbench/startup.h",
  27.          "dos.lib"}
  28.  
  29. TYPE
  30.   String200 = STRING[200];
  31.   String256 = STRING[256];
  32.  
  33. CONST
  34.   vertag = "$VER: GuideStripper V1.00 (21.11.1994)";
  35.    
  36. VAR
  37.   StMess            : p_WBStartup;                      STATIC;
  38.   f,f1              : Text;                             STATIC;
  39.   source,dest,pf,
  40.   zeile             : String200;                        STATIC;
  41.   dummy             : BOOLEAN;                          STATIC;
  42.   c                 : CHAR;                             STATIC;
  43.   i,zähler,fs,old,
  44.   OldLock           : LONG;                             STATIC;
  45.   wp                : p_Window;                         STATIC;
  46.   t                 : ARRAY[1..10] OF TagItem;          STATIC;
  47.   psw,psh,xoff,yoff,
  48.   FontX, FontY,WBR,
  49.   WBB,ww,wh         : INTEGER;                          STATIC;
  50.   MyTattr           : p_TextAttr;                       STATIC;
  51.   psfont            : p_TextFont;                       STATIC;
  52.   ps                : p_Screen;                         STATIC;
  53.   vi                : PTR;                              STATIC;
  54.   lib               : p_Library;                        STATIC;
  55.   tattr             : TextAttr;                         STATIC;
  56.  
  57. PROCEDURE UMeld(txt:String200; gad:STRING);
  58. VAR
  59.   es : EasyStruct;
  60.   l  : LONG;
  61. BEGIN
  62.   es := EasyStruct(SizeOf(EasyStruct),0,"Usermeldung:",^txt,^gad);
  63.   l := EasyRequestArgs(NIL,^es,NIL,NIL);
  64. END;
  65.  
  66. PROCEDURE CloneDatas;
  67. BEGIN
  68.   ps := LockPubScreen("Workbench");
  69.   IF ps = NIL THEN
  70.   BEGIN
  71.      UMeld("Kann den Workbenchscreen nicht locken !!","Gelesen!");
  72.      HALT(20);
  73.   END ELSE
  74.   BEGIN
  75.      psw := ps^.Width;
  76.      psh := ps^.Height;
  77.      WBR := ps^.WBorRight;
  78.      WBB := ps^.WBorBottom;
  79.      psfont := ps^.RastPort.Font;
  80.      xoff := ps^.WBorLeft;
  81.      yoff := ps^.BarHeight;
  82.      vi := GetVisualInfoA(ps, NIL);
  83.      UnLockPubScreen(NIL, ps);
  84.      IF vi = NIL THEN
  85.      BEGIN
  86.         UMeld("Konnte keine VisualInfo bekommen !!","Ohje!");
  87.         HALT(20);
  88.      END;
  89.   END;
  90. END;
  91.     
  92. FUNCTION ComputeX(value:INTEGER) : INTEGER;
  93. BEGIN
  94.   ComputeX := ((FontX * value)+4) DIV 8;
  95. END;
  96.  
  97. FUNCTION ComputeY(value:INTEGER) : INTEGER;
  98. BEGIN
  99.   ComputeY := ((FontY*value)+4) DIV 8;
  100. END;
  101.  
  102. PROCEDURE ComputeFont(width,height : INTEGER);
  103. LABEL UseTopaz;
  104. BEGIN
  105.   Forbid;
  106.   MyTattr := ^tattr;
  107.   MyTattr^.ta_Name := psfont^.tf_Message.mn_Node.ln_Name;
  108.   MyTattr^.ta_YSize := psfont^.tf_YSize;
  109.   FontY := psfont^.tf_YSize;
  110.   FontX := psfont^.tf_XSize;
  111.   Permit;
  112.   IF (width>0) AND (height>0) THEN
  113.   BEGIN
  114.     IF ( (ComputeX(width)+xoff+WBR)>psw) THEN GOTO UseTopaz;
  115.     IF ( (ComputeY(height)+yoff+WBB)>psh) THEN GOTO UseTopaz;
  116.   END;
  117.   EXIT;
  118. UseTopaz:
  119.   MyTattr^.ta_Name := "topaz.font";
  120.   FontX := 8;
  121.   FontY := 8;
  122.   MyTattr^.ta_Flags := FPF_ROMFONT;
  123.   MyTattr^.ta_YSize := 8;
  124. END;
  125.     
  126. FUNCTION AslFileReq(tit:STRING; VAR Filename,Dirname:String200) : BOOLEAN;
  127. VAR
  128.   Req : p_Filerequester;
  129.   t   : ARRAY[0..7] OF TagItem;
  130.   bool: BOOLEAN;
  131.   Dir1: String200;
  132. BEGIN
  133.   t[0].ti_Tag := ASL_Hail;
  134.   t[0].ti_Data := tit;
  135.   t[1].ti_Tag := ASL_File;
  136.   t[1].ti_Data := ^Filename;
  137.   t[2].ti_Tag := ASL_Dir;
  138.   t[2].ti_Data := ^Dirname;
  139.   t[3] := TagItem(ASL_Width,350);
  140.   t[4] := TagItem(ASL_Height,200);
  141.   t[5] := TagItem(ASL_TopEdge,0);
  142.   t[6].ti_Tag := TAG_DONE;
  143.   Req := AllocAslRequest(ASL_Filerequest, ^t);
  144.   IF Req <> NIL THEN
  145.   BEGIN
  146.     IF AslRequest(Req,^t) THEN
  147.     BEGIN
  148.        AslFileReq := TRUE;
  149.        Filename:=req^.rf_File;
  150.        Dirname:=req^.rf_Dir;
  151.          IF DirName <> "" THEN
  152.        IF (Dirname[length(dirname)]<>':') AND (Dirname[length(dirname)]<>'/')
  153.         THEN Dirname:=Dirname+'/';
  154.     END ELSE AslFileReq := FALSE;
  155.     FreeAslRequest(Req);
  156.   END ELSE
  157.   BEGIN
  158.      AslFileReq := FALSE;
  159.     DisplayBeep(NIL);
  160.     UMeld("ASLRequest-Struktur konnte nicht"+CHR(10)+"angelegt werden !!","Huch?");
  161.   END;
  162. END;
  163.  
  164. PROCEDURE Prozent(VAR max,akt : LONG);
  165. VAR
  166.   p,y : LONG;
  167.   s   : STRING;
  168.   it  : IntuiText;
  169.   dummy : LONG;
  170. BEGIN
  171.   p := Round((akt * 100) / max);
  172.   IF (p>0) AND (old <> p) THEN
  173.   BEGIN
  174.      old := p;
  175.      y := Round( (p * 196) / 100);
  176.      s := IntStr(p);
  177.      IF p<10 THEN s := "  "+s
  178.      ELSE IF p<100 THEN s := " "+s;
  179.      s := s + "%";
  180.      SetAPen(wp^.RPort,3);
  181.      RectFill(wp^.RPort,xoff+ComputeX(4),yoff+ComputeY(3),
  182.                         xoff+ComputeX(2)+ComputeX(y),
  183.                               yoff+ComputeY(30));
  184.      it := IntuiText(1,3,JAM2,0,0,MyTattr,s,NIL);
  185.      PrintIText(wp^.RPort,^it,xoff+ComputeX(86),yoff+ComputeY(11)+
  186.                 ComputeY(2));                          
  187.   END;
  188. END;
  189.  
  190. PROCEDURE OverReadLine;
  191. BEGIN
  192.   ReadLn(f, zeile);
  193.   zähler := zähler + Length(zeile);
  194.   Prozent(fs,zähler);
  195. END;
  196.  
  197. PROCEDURE ReadChar;
  198. BEGIN
  199.   Read(f, c);
  200.   Inc(zähler);
  201.   Prozent(fs,zähler);
  202. END;
  203.  
  204. PROCEDURE OpenWin;
  205. VAR
  206.   it : IntuiText;
  207. BEGIN
  208.   ComputeFont(220,50);
  209.   ww := ComputeX(220);
  210.   wh := ComputeY(50);
  211.   t[1] := TagItem(WA_InnerWidth, ww);
  212.   t[2] := TagItem(WA_InnerHeight, wh);
  213.   t[3].ti_Tag := WA_Title;
  214.   t[3].ti_Data := "GuideStripper V1.00";
  215.   t[4] := TagItem(WA_Flags, WFLG_DEPTHGADGET+
  216.                             WFLG_ACTIVATE+
  217.                                      WFLG_DRAGBAR);
  218.   t[5].ti_Tag := WA_ScreenTitle;
  219.   t[5].ti_Data := "GuideStripper V1.00 ©1994 by Björn Schotte -=- BomberSoft@bomber.mayn.sub.de";                                     
  220.   t[6].ti_Tag := TAG_DONE;
  221.   
  222.   wp := OpenWindowTagList(NIL, ^t);
  223.   IF wp = NIL THEN
  224.   BEGIN
  225.      UMeld("Konnte kein Fenster öffnen !!","Ooops!");
  226.      Close(f);
  227.      Close(f1);
  228.      ww := DeleteFile(dest);
  229.      HALT(20);
  230.   END;                
  231.   t[1] := TagItem(GTBB_Recessed, 1);
  232.   t[2] := TagItem(GT_VisualInfo, LONG(vi));
  233.   t[3].ti_Tag := TAG_DONE;
  234.   DrawBevelBoxA(wp^.RPort,xoff+ComputeX(2),yoff+ComputeY(2),
  235.                           ComputeX(200),ComputeY(30),^t);                 
  236.   SetAPen(wp^.RPort,1);                                  
  237.   Move(wp^.RPort,xoff+ComputeX(2),yoff+ComputeY(32));
  238.   Draw(wp^.RPort,xoff+ComputeX(2),yoff+ComputeY(37));                                  
  239.   it := IntuiText(1,0,JAM1,0,0,MyTattr,"0%",NIL);
  240.   PrintIText(wp^.RPort,^it,xoff+ComputeX(2),yoff+ComputeY(38));
  241.   
  242.   Move(wp^.RPort,xoff+ComputeX(102),yoff+ComputeY(32));
  243.   Draw(wp^.RPort,xoff+ComputeX(102),yoff+ComputeY(37));                                  
  244.   it := IntuiText(1,0,JAM1,0,0,MyTattr,"50%",NIL);
  245.   PrintIText(wp^.RPort,^it,xoff+ComputeX(96),yoff+ComputeY(38));
  246.  
  247.   Move(wp^.RPort,xoff+ComputeX(202),yoff+ComputeY(32));
  248.   Draw(wp^.RPort,xoff+ComputeX(202),yoff+ComputeY(37));                                  
  249.   it := IntuiText(1,0,JAM1,0,0,MyTattr,"100%",NIL);
  250.   PrintIText(wp^.RPort,^it,xoff+ComputeX(185),yoff+ComputeY(38));
  251. END;
  252.  
  253. PROCEDURE CloseWin;
  254. BEGIN
  255.   IF wp <> NIL THEN CloseWindow(wp);
  256. END;
  257.  
  258. BEGIN
  259.   lib := IntuitionBase;
  260.   IF lib^.lib_Version < 37 THEN
  261.   BEGIN
  262.      IF FromWB THEN
  263.      BEGIN
  264.        Reset(input,"CON:0/0/200/60/Fehler!");
  265.         output := input;
  266.      END;
  267.      WriteLn(#27"[1mGuideStripper läuft nur ab OS2.04 !!!"+CHR(27)+"[0m");
  268.      IF FromWB THEN
  269.      BEGIN
  270.         Delay(100);
  271.         Close(input);
  272.      END;
  273.      HALT(20);
  274.   END;
  275.   IF FromWB THEN
  276.   BEGIN
  277.      StMess := StartupMessage;
  278.      OldLock := CurrentDir(StMess^.sm_ArgList^.wa_Lock);
  279.   END;
  280.   ASLBase := OpenLibrary("asl.library", 37);
  281.   IF ASLBase = NIL THEN
  282.   BEGIN
  283.      UMeld("asl.library V37 oder besser konnte nicht geöffnet werden!","Uups");
  284.      HALT(20);
  285.   END;
  286.   GadToolsBase := OpenLibrary("gadtools.library", 37);
  287.   IF GadToolsBase = NIL THEN
  288.   BEGIN
  289.      CloseLibrary(DOSBase);
  290.      UMeld("gadtools.library V37 oder besser konnte nicht geöffnet werden!","Uups");
  291.      HALT(20);
  292.   END;
  293.   DOSBase := OpenLibrary("dos.library", 37);
  294.   IF DOSBase = NIL THEN
  295.   BEGIN
  296.      CloseLibrary(ASLBase);
  297.      CloseLibrary(GadToolsBase);
  298.      UMeld("dos.library V37 oder besser konnte nicht geöffnet werden!","Uups");
  299.      HALT(20);
  300.   END;
  301.   tattr := TextAttr("topaz.font",8,0,0);
  302.   CloneDatas;
  303.   zähler := 0;
  304.   old := -1;
  305.   pf := "";
  306.   source := "";
  307.   dest := "";
  308.   dummy := ASLFileReq("Bitte Quelldatei auswählen:",source,pf);
  309.   IF dummy = FALSE THEN HALT(20);
  310.   source := pf + source;
  311.   dummy := ASLFileReq("Bitte Zieldatei auswählen:",dest,pf);
  312.   IF dummy = FALSE THEN HALT(20);
  313.   dest := pf + dest;
  314.   Reset(f, source);
  315.   IF IOResult <> 0 THEN
  316.   BEGIN
  317.      UMeld("Konnte die Datei"+CHR(10)+source+CHR(10)+"nicht öffnen!!!","ok");
  318.      HALT(20);
  319.   END;
  320.   Buffer(f, 10000);
  321.   fs := FileSize(f);
  322.   ReWrite(f1, dest);
  323.   IF IOResult <> 0 THEN
  324.   BEGIN
  325.      UMeld("Konnte die Datei"+CHR(10)+dest+CHR(10)+"nicht anlegen!!!","ok");
  326.      HALT(20);
  327.   END;
  328.   OpenWin;
  329.   WHILE NOT EOF(f) DO
  330.   BEGIN
  331.      ReadChar;
  332.      IF c <> "@" THEN 
  333.      BEGIN
  334.         CASE c OF
  335.           "\" : BEGIN
  336.                    ReadChar;
  337.                      CASE c OF
  338.                       "@" : Write(f1,c);
  339.                       CHR(34) : Write(f1,c);
  340.                      ELSE
  341.                        Write(f1,"\"+c);
  342.                      END;
  343.                  END;
  344.         ELSE
  345.           Write(f1, c);
  346.         END;  
  347.      END ELSE
  348.      BEGIN
  349.         ReadChar;
  350.         CASE c OF
  351.            "D","d",
  352.             "M","m",
  353.             "A","a",
  354.             "(",
  355.             "R","r",
  356.             "$",
  357.             "F","f",
  358.             "H","h",
  359.             "W","w",
  360.             "H","h",
  361.             "T","t",
  362.             "I","i",
  363.             "E","e",
  364.             "P","p",
  365.             "H","h" : OverReadLine;
  366.             
  367.            "N","n":
  368.               BEGIN
  369.                  ReadChar;
  370.                  IF UpCase(c) = "E" THEN OverReadLine ELSE
  371.                  BEGIN
  372.                      FOR i := 1 TO 3 DO ReadChar; { ODE }
  373.                      zeile := "";
  374.                      REPEAT
  375.                        ReadChar;
  376.                         zeile := zeile + c;
  377.                     UNTIL c = CHR(10);
  378.                      IF POS(CHR(34),zeile)<>0 THEN
  379.                      BEGIN
  380.                         Delete(zeile,1,POS(CHR(34),zeile));
  381.                         i := 1;
  382.                         Writeln(f1);
  383.                         Write(f1,CHR(27)+"[7m");
  384.                         WHILE zeile[i] <> CHR(34) DO
  385.                         BEGIN
  386.                           Write(f1,zeile[i]);
  387.                           Inc(i);
  388.                         END;
  389.                         Writeln(f1,CHR(27)+"[0m");
  390.                         Writeln(f1);
  391.                      END ELSE
  392.                      BEGIN
  393.                         i := 1;
  394.                         WHILE zeile[i] = " " DO Inc(i);
  395.                         Delete(zeile,1,i-1);
  396.                         Writeln(f1);
  397.                         Writeln(f1,CHR(27)+"[7m"+zeile+CHR(27)+"[0m");
  398.                         Writeln(f1);
  399.                      END;
  400.                 END;
  401.               END;
  402.           "{" : BEGIN
  403.                    ReadChar;
  404.                      CASE c OF
  405.                        "F","f" :
  406.                           BEGIN
  407.                              REPEAT
  408.                                ReadChar;
  409.                             UNTIL c = "}";
  410.                           END;  
  411.                        CHR(34):
  412.                           BEGIN
  413.                              REPEAT
  414.                                ReadChar;
  415.                                 IF c<>CHR(34) THEN Write(f1,c);
  416.                             UNTIL c = CHR(34);
  417.                              WHILE c<>"}" DO ReadChar;
  418.                           END;
  419.                        "B","b": BEGIN
  420.                                     ReadChar;
  421.                                       IF c = "}" THEN Write(f1, CHR(27)+"[1m")
  422.                                       ELSE
  423.                                       BEGIN
  424.                                          REPEAT
  425.                                            ReadChar;
  426.                                          UNTIL c = "}";
  427.                                       END;
  428.                                   END;
  429.                         "I","i": BEGIN
  430.                                     Write(f1, CHR(27)+"[3m");
  431.                                       ReadChar;
  432.                                     END;
  433.                        "U","u": BEGIN
  434.                                     ReadChar;
  435.                                       IF c = "}" THEN
  436.                                       BEGIN
  437.                                       Write(f1, CHR(27)+"[4m");
  438.                                         ReadChar;
  439.                                       END ELSE
  440.                                       BEGIN
  441.                                          CASE c OF
  442.                                       "B","b": BEGIN
  443.                                                    Write(f1, CHR(27)+"[22m");
  444.                                                      ReadChar;
  445.                                                  END;
  446.                                         "I","i": BEGIN
  447.                                                    Write(f1, CHR(27)+"[23m");
  448.                                                         ReadChar;
  449.                                                      END;
  450.                                             "U","u": BEGIN
  451.                                                         Write(f1, CHR(27)+"[24m");
  452.                                                           ReadChar;
  453.                                                         END;            
  454.                                           ELSE END;
  455.                                       END;
  456.                                     END;
  457.                          ELSE END;
  458.                  END;
  459.         ELSE END;
  460.      END;
  461.   END;
  462.   Close(f);
  463.   Close(f1);
  464.   Delay(50);
  465.   CloseWin;
  466.   CloseLibrary(DOSBase);
  467.   CloseLibrary(ASLBase);
  468.   CloseLibrary(GadToolsBase);
  469. END.
  470.